The World of Computer Software/The World of Computer Software.iso/depth.zip/DEPTH.BAS

BASIC Source File | 1988-02-29 | 11KB | 206 lines

10 'depth charge - j.m. kotler  1982
11 'requires BASICA
15 'release 1.1: Improved hit detection. Added bonus for hitting conning tower.
20 'release 1.2: Added vertical mvmt. Fixed 'illegal function' bug. 25.28/P
25 WIDTH 80
30 LOCATE 1,1,0'ensure cursor is off if run as parm
40 KEY OFF
50 DEFINT A-Z
60 DY = 1
70 YMAX=25' max depth of subs and depthcharges - can be set lower for easy game
80 SMINY=4 'min depth of subs - can be set higher for harder game
90 DIM MINSCORE(25) 'MIN SCORE FOR EACH PASS - INIT TO MINIMAL SCORE NEEDED TO GET ANOTHER BONUS PASS - FIRST 3 ARE 0
100 BONUSP=5' first bonus pass #
110 MINSCORE (BONUSP)=50*(BONUSP-1)
120 FOR P=BONUSP+1 TO 25:MINSCORE(P)=MINSCORE(P-1)+10*P:NEXT
130 B$=" " ' background
140 D$="═╧═≈≈":DB$="     " 'destroyer and erase
150 C$="°":C2$="∞" 'depthcharge - alternating characters
160 S$="───╨──":SB$="      " 'sub and erase
170 AS1=ASC("─"):AS2=ASC("╨")
180 SXMAX = 80-(LEN(S$)+1)
190 DIM BM$(11,4)
200 BM$(0,0)="     ":BM$(1,0)="     ":BM$(2,0)="  ░  ":BM$(3,0)=" ░■░ "
210 BM$(0,1)="     ":BM$(1,1)="     ":BM$(2,1)=" ░■░ ":BM$(3,1)="▒█▓█▒"
220 BM$(0,2)="     ":BM$(1,2)="     ":BM$(2,2)=" ▓░▓▒":BM$(3,2)="░▒▓▒░"
230 BM$(0,3)="     ":BM$(1,3)=" ░▒░ ":BM$(2,3)="▒■▒▓▒":BM$(3,3)="boom!"
240 BM$(0,4)="░▒  ░":BM$(1,4)="BOOM!":BM$(2,4)="▓░ ░▓":BM$(3,4)="■   ■"
250 '
260 BM$(4,0)="░  ▄ ":BM$(5,0)="  ■  ":BM$(6,0)="  ■  ":BM$(7,0)="     "
270 BM$(4,1)=" ▓█ ░":BM$(5,1)=" ■ ▓ ":BM$(6,1)=" ░ ■ ":BM$(7,1)="     "
280 BM$(4,2)="▐░ █▒":BM$(5,2)="░░  ░":BM$(6,2)=" ■   ":BM$(7,2)="     "
290 BM$(4,3)="BOOM!":BM$(5,3)="B00M!":BM$(6,3)="▒ooM■":BM$(7,3)="     "
300 BM$(4,4)=" ▀  ▄":BM$(5,4)="░    ":BM$(6,4)="   ■ ":BM$(7,4)="     "
310 '
320 BM$(8,0)="  B  ":BM$(9,0)=" °B∙ ":BM$(10,0)="  B∙ ":BM$(11,0)=" ·B  "
330 BM$(8,1)=" ∙O°·":BM$(9,1)=" ∙Oo ":BM$(10,1)="° O ∙":BM$(11,1)=" °O· "
340 BM$(8,2)="° N· ":BM$(9,2)=" °N∙°":BM$(10,2)="· N o":BM$(11,2)="· N° "
350 BM$(8,3)=" ∙U o":BM$(9,3)="o U° ":BM$(10,3)=".·U∙ ":BM$(11,3)=" °U· "
360 BM$(8,4)="--S--":BM$(9,4)="∙-S-∙":BM$(10,4)=" -S-°":BM$(11,4)=" .S∙ "
361 '
362 BT$(0,0)=" ":BT$(1,0)=" ":BT$(2,0)=" ":BT$(3,0)=" ":BT$(4,0)="╨"
363 BT$(0,1)=" ":BT$(1,1)=" ":BT$(2,1)=" ":BT$(3,1)="╞":BT$(4,1)="·"
364 BT$(0,2)=" ":BT$(1,2)=" ":BT$(2,2)="╥":BT$(3,2)="·":BT$(4,2)="∙"
365 BT$(0,3)=" ":BT$(1,3)="╡":BT$(2,3)="·":BT$(3,3)="∙":BT$(4,3)=" "
366 BT$(0,4)="╨":BT$(1,4)="·":BT$(2,4)="∙":BT$(3,4)=" ":BT$(4,4)=" "
370 GOSUB 980 'instructions
380 RANDOMIZE  VAL(RIGHT$(TIME$,2))
390 AGAIN$="Y"
400 WHILE AGAIN$<>"n" AND AGAIN$<>"N"
410 'START NEW GAME
420 COLOR 7:CLS
430 COLOR 1:LOCATE DY:FOR X=1 TO 80:PRINT B$;:NEXT:COLOR 7
440 FOR C=0 TO 4: X(C)=C:Y(C)=1:NEXT
450 FOR S=1 TO 4: SX(S)=1+RND*SXMAX:SY(S)=SMINY+RND*(YMAX-SMINY):NEXT
460 KEY (14) ON
470 LOCATE DY+1
480 IF B$ <> " " THEN FOR Y=1 TO (YMAX-DY-1)*80-1:PRINT B$;:NEXT
490 FC=4
500 SCORE=0:P=1:RVY=80*(BONUSP-1)+1
510 ON KEY(14) GOSUB 940
520  WHILE SCORE >= MINSCORE(P) AND P<25
530 DX=80-LEN(DB$)
540 DX=80-LEN(D$)+1
550 WHILE DX
560 COLOR 6,1,0:LOCATE 1,1:IF SCORE < MINSCORE (P+1) THEN PRINT "["; ELSE PRINT " ";
570 LOCATE ,70:PRINT P;SCORE;:LOCATE DY,DX:PRINT D$;:COLOR 7
580 ALT = NOT ALT
590 FOR C=1 TO 4
600 Y=Y(C):IF Y >1 THEN X=X(C):SCR=SCREEN (Y,X):IF (SCR=AS1 OR SCR=AS2) THEN GOSUB 850:ELSE LOCATE Y,X: IF ALT THEN PRINT C2$;:ELSE PRINT B$;:Y=Y+1:IF Y>YMAX THEN Y(C)=1:X(C)=C:GOSUB 910 ELSE LOCATE Y,X:PRINT C$;:Y(C)=Y
610 NEXT
620 FOR S=1 TO 4:Y=SY(S):X=SX(S):LOCATE Y,X:PRINT SB$;:IF S>1 THEN X=X+1:SX(S)=X:IF X>SXMAX THEN X=1 :SX(S)=X
625 IF DRVY THEN GOSUB 725
630 LOCATE Y,X:PRINT S$;
640 NEXT
642 IF RVY THEN RVY=RVY-1 ELSE RVY=RND*80/(P-BONUSP+1):SRVY=RND*4+1:DRVY=RND*6+1-4
650 COLOR 1:LOCATE DY,DX:PRINT DB$;:COLOR 7:DX = DX -1
660 WEND
670 P=P+1
680 WEND
690 IF SCORE > HISCORE THEN HISCORE = SCORE
700 LOCATE 1,20:PRINT "score=";SCORE;" high score=";HISCORE;" PLAY AGAIN [y/n]";:AGAIN$=INKEY$:IF NOT (AGAIN$="y" OR AGAIN$="Y" OR AGAIN$="n" OR AGAIN$="N") THEN 700
710 WEND
720 CLS:KEY ON:END
725 IF SRVY=S THEN YT=Y+SGN(DRVY):DRVY=DRVY-SGN(DRVY):IF (YT >=SMINY AND YT=< YMAX)THEN Y=YT:SY(S)=Y
729 RETURN
730 'XPLOSION
740 COLOR 15
745 SOUND 37,3:SOUND 70,4:SOUND 150,7:SOUND 267,5:SOUND 100,3:SOUND 37,5
770 IF Y > 5 THEN MAXR = 4 ELSE MAXR=Y-2
780 IF XL=XH THEN IF SX(S)=XL-2+(S=1) THEN SCORE=SCORE+Y:FOR EX=0 TO 4:FOR XR=0 TO MAXR:LOCATE Y-MAXR+XR,XL+1+(S=1):PRINT BT$(EX,XR);:NEXT:FOR JK=1 TO EX*EX*30:NEXT:NEXT:FOR EX=8 TO 11:FOR XR=0 TO MAXR:LOCATE Y-MAXR+XR,X+1:PRINT BM$(EX,XR);:NEXT:NEXT
784 IF XL=XH THEN IF SX(S)=XL-2+(S=1) THEN FOR EX=4 TO 0 STEP -1:FOR XR=0 TO MAXR:LOCATE Y-MAXR+XR,XL+1+(S=1):PRINT BT$(EX,XR);:NEXT:FOR JK=1 TO EX*EX*50:NEXT:NEXT
788 LOCATE Y,X:PRINT"■■■■■ ";
790 IF X<XL THEN XL=X
800 IF X+6>XH THEN XH=X+6
810 FOR EX=0 TO 7:FOR XR=0 TO MAXR:LOCATE Y-MAXR+XR,X:PRINT BM$(EX,XR);:NEXT:NEXT
820 COLOR 7
830 LOCATE Y,X:PRINT "       ";
840 RETURN
850 'BLOWED-UP SUB
860 Y(C)=1:GOSUB 910
870 XL=X:XH=X:PS=-1
880 WHILE SCORE >PS:PS=SCORE:FOR S=1 TO 4:IF SY(S)=Y THEN IF SX(S)=<XH THEN IF SX(S)+6>XL THEN X=SX(S):GOSUB 730:SCORE=SCORE+Y:SY(S)=SMINY+RND*(YMAX-SMINY):SX(S)=1+RND*SXMAX
890 NEXT:WEND
900 RETURN
910 'FREED UP DEPTH CHG
920 FC=FC+1:IF FC= 1 THEN KEY (14) ON
930 RETURN
935 'attempt to drop one
940 N=4:WHILE Y(N)>1:N=N-1:WEND:IF N THEN Y(N)=DY+1:X(N)=DX:IF DX<1 THEN X(N)=1
960 FC=FC-1 :IF FC = 0 THEN KEY (14) OFF
970 RETURN
980 '
1000 GOSUB 1330
1010 GOSUB 1220
1020 PRINT"Do you wish to see instructions?[y/n] "
1030 A$=INKEY$:IF A$="" THEN 1030 ELSE IF (A$="n" OR A$="N") THEN RETURN
1040 LOCATE 10
1050 PRINT"INSTRUCTIONS: Object of the game is to drop depth charges from the destroyer":PRINT"at the top of the screen, and hit the submarines scattered below."
1060 PRINT
1070 PRINT"The destroyer is above the waterline and moves toward the left. When it":PRINT"passes off the left side of the screen, it reappears on the right. The '2' at":PRINT"the top right tells what pass your on. The other number, where the '35' is,"
1080 PRINT"is your current score.":PRINT:PRINT"There are 4 subs. While you move left, they move right, except one of them,":PRINT"which is always stationary."
1090 GOSUB 1290:GOSUB 1220
1100 DA$=CHR$(25)
1110 PRINT"You drop a depth charge by pressing the 'down arrow' [";DA$;"] key."
1120 PRINT"You can only drop 4 depth charges at a time. That is, if 4 of them are":PRINT"currently floating down, you have to wait for one of them to hit a sub or":PRINT"reach the bottom of the screen before you will be able to drop another - so"
1130 PRINT"it's important to plan your drops carefully.":PRINT:PRINT"Scoring - the deeper the sub, the more points you get when you hit it.":PRINT"You get double points if you get a direct hit on the conning tower [╨]."
1135 PRINT:PRINT"When a sub is hit, it will reappear at some random location. Sometimes subs"
1140 PRINT"overlap - this gives you a chance to hit two with one charge."
1150 GOSUB 1290:GOSUB 1220
1160 PRINT"You get four passes across the screen with your destroyer. On the last"
1170 PRINT"pass, a '[' will appear at the upper left to alert you. If you manage to ":PRINT"accumulate at least 200 points before the destroyer reaches the '[', the '['":PRINT"will disappear and you will get a bonus pass. You may earn additional bonus"
1180 PRINT"passes, but it gets harder and harder. Whenever you fall behind the points":PRINT"needed for an additional pass, the '[' will reappear."
1190 GOSUB 1290
1200 GOTO 1010
1210 RETURN
1220 '
1230 COLOR 7:CLS
1240 COLOR 1:PRINT SPC(79)
1250 LOCATE 1,1:PRINT"[";:LOCATE ,20 :PRINT"DEPTH CHARGE";:LOCATE ,60:PRINT D$;"   2  35":COLOR 7
1260 LOCATE 8,6:PRINT S$:LOCATE 5,42:PRINT S$:LOCATE 4,30:PRINT C2$:LOCATE 7,58:PRINT C2$
1270 LOCATE 10,1
1280 RETURN
1290 '
1300 PRINT:PRINT"              (Press any key to continue)"
1310 A$=INKEY$: IF A$ = "" THEN 1310
1320 RETURN
1330 '
1340 'title
1350 KEY OFF:CLS:COLOR 7,1,0
1360 LOCATE 6:X=36:GOSUB 1370:LOCATE 9,X+12:PRINT"RELEASE 1.2";:LOCATE 1:X=15:GOSUB 1370:GOTO 1440
1370 LOCATE ,X:PRINT"                   ┌─┴────┐"
1380 LOCATE ,X:PRINT"┌──────────────────┴......│"
1390 LOCATE ,X:PRINT"│⌐  ⌐                     ┴──────────────┐"
1400 LOCATE ,X:PRINT"│                                        │"
1410 LOCATE ,X:PRINT"└─┐.  .  .  .  . . . . . . .......╓──────┴─╫"
1420 LOCATE ,X:PRINT"  └───────────────────────────────╜"
1430 RETURN
1440 PRINT" "
1450 '
1460 PRINT"    ▒▒▓░    ▒▒▒▓▓   ▒▓▓▒░   ░░▒▒▓▓▒  ▒    ░ "
1470 PRINT"    ▒   ▒   ▓       ░    ▓     ▒     ▓    ▒ "
1480 PRINT"    ▓    ▓  ▒       ▒    ▓     ▓     ▓    ▒ "
1490 PRINT"    ▒    ▒  ░░░░▒   ▒▒░░▒      ▓     ▒▒░░▒▓ "
1500 PRINT"    ░    ░  ░       ▓          ▒     ░    ▓ "
1510 PRINT"    ░   ░   ░       ▓          ░     ░    ▒ "
1520 PRINT"    ▒▒▓░    ▒▒▒▓▓   ▒          ░     ▒    ░ "
1530 PRINT" "
1540 PRINT"                  ▒▒▓░    ▒    ▓    ▓▓▒░   ░░▒▒▓▓    ▒▒░░    ░░▒▓▓ "
1550 PRINT"                 ▒▒   ▒   ▓    ▓   ░    ▓  ▒     ▓  ▒░   ▒   ▒     "
1560 PRINT"   Jerry Kotler  ▓        ▒    ▒   ▒    ▓  ▓     ▓  ▒        ▓     "
1570 PRINT"   I S Services  ▒        ░░░▒░▒   ▒▒░░▒▒  ▓▒░░▒▓   ▓   ▒▓▒  ▒░▒▓  "
1580 PRINT"   Los  Angeles  ░        ░    ░   ▓    ░  ▒   ░    ▓    ▓   ▒     "
1590 PRINT"                 ░░   ░   ░    ░   ▓    ░  ░    ░   ▒▒   ▒   ░     "
1600 PRINT"                  ▒▒▓░    ▒    ▒   ▒    ▒  ░     ▒   ░░▒▓    ░▒▓▒░ "
1610 COLOR 7
1620 DEF SEG
1630 B=0:V=0:SA%=0:N=0
1640 DATA 30, 184,0, 176, 142, 216, 176, 24, 187, 1,0, 185, 79,0, 138, 39, 138, 87, 2, 136, 23, 67, 67, 226, 247, 136, 39, 67, 67, 254, 200, 117, 234, 31, 203
1650 L=35
1660 DIM S%(L/2+1)
1670 SA%=VARPTR (S%(0))
1680 FOR B=SA% TO SA%+L-1:READ V:POKE B,V:NEXT
1690 'set highlights
1700 BUF=&HB000
1710 ATP$="11111111111100222001111111002200111110001110000111110000111000011111111000222000" '1=hilite,0=normal,2=invisible
1720 AT%(0)=7:AT%(1)=15:AT%(2)=0
1730 A=1:YE=23*160:DEF SEG=BUF
1740 FOR N=1 TO 80:N0=AT%(VAL(MID$(ATP$,N,1))):FOR Y=A TO YE STEP 160:POKE Y,N0:NEXT:A=A+2:NEXT
1750 DEF SEG:SY=0:SA%=VARPTR(S%(0)):SY=SA%+7
1760 FOR Y=3 TO 1 STEP -1 :POKE SY,Y:FOR N=1 TO 79:CALL SA%:NEXT:NEXT:POKE SY,24
1770 FOR Y=1 TO 24:POKE SY,Y:FOR N=1 TO INT(Y/6):CALL SA%:NEXT:NEXT
1780 COLOR 0:PRINT SPC(30);"Press any key to start";:LOCATE ,60:COLOR 7:PRINT SPC(19);
1790 DEF SEG
1800 N1=30:N2=1000:S1=5:W1=0:W2=10000:W=0
1810 A$="":SA%=VARPTR(S%(0))
1820 WHILE A$=""
1830 S1=RND*3+2
1840 FOR N=N1 TO N2 STEP S1:CALL SA%:FOR W=W1 TO W2 STEP N:NEXT:A$=INKEY$:IF A$ <>"" THEN N=N2
1850 NEXT
1860 IF A$<>"" THEN 1890
1870 FOR N=N2 TO N1 STEP -S1:CALL SA%:FOR W=W1 TO W2 STEP N:NEXT:A$=INKEY$:IF A$<>"" THEN N=N1
1880 NEXT
1890 WEND
1900 WHILE A$<>"":A$=INKEY$:WEND 'flush buffer
1910 RETURN